home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / hottra1a / module1.bas < prev    next >
BASIC Source File  |  1999-07-29  |  3KB  |  93 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  
  4. Private Type MENUITEMINFO
  5.     cbSize As Long
  6.     fMask As Long
  7.     fType As Long
  8.     fState As Long
  9.     wID As Long
  10.     hSubMenu As Long
  11.     hbmpChecked As Long
  12.     hbmpUnchecked As Long
  13.     dwItemData As Long
  14.     dwTypeData As String
  15.     cch As Long
  16. End Type
  17.  
  18. Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" _
  19.     (ByVal hMenu As Long, _
  20.      ByVal un As Long, _
  21.      ByVal b As Long, _
  22.      lpMenuItemInfo As MENUITEMINFO) As Long
  23.  
  24. Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
  25.     (Destination As Any, _
  26.      Source As Any, ByVal Length As Long)
  27.  
  28. Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  29.  
  30. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  31.  
  32. Private Const GWL_WNDPROC = (-4)
  33. Private Const WM_MENUSELECT = &H11F
  34. Private Const MF_BYCOMMAND = &H0&
  35. Private Const MF_BYPOSITION = &H400&
  36. Private Const MF_MENUBREAK = &H40&
  37. Private Const MF_STRING = &H0&
  38. Private Const MF_HELP = &H4000&
  39. Private Const MFS_DEFAULT = &H1000&
  40. Private Const MIIM_ID = &H2
  41. Private Const MIIM_SUBMENU = &H4
  42. Private Const MIIM_TYPE = &H10
  43. Private Const MIIM_DATA = &H20
  44.  
  45. Private lOldWndProc As Long
  46. Private lHook As Long
  47. Private bIsHooked As Boolean
  48.  
  49. Private Function HookMessages(ByVal lhWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  50.  
  51.   Select Case msg
  52.     Case WM_MENUSELECT
  53.       Dim s$, l&, Low As Long
  54.       Dim mnu As MENUITEMINFO
  55.       s = Space(80)
  56.       With mnu
  57.         .cbSize = Len(mnu)
  58.         .dwTypeData = s & Chr(0)
  59.         .fType = MF_STRING
  60.         .cch = Len(.dwTypeData)
  61.         .fState = MFS_DEFAULT
  62.         .fMask = MIIM_ID Or MIIM_SUBMENU Or MIIM_DATA Or MIIM_TYPE
  63.         .hSubMenu = lParam
  64.       End With
  65.       
  66.       Call CopyMem(Low, ByVal VarPtr(wParam), 2)
  67.       
  68.       l = GetMenuItemInfo(lParam, Low, True, mnu)
  69.       
  70.       If l = 0 Then
  71.         l = GetMenuItemInfo(lParam, Low, False, mnu)
  72.       End If
  73.       s = mnu.dwTypeData
  74.       s = Trim(Replace(Replace(s, Chr(0), ""), "&", ""))
  75.       Form1.List1.AddItem s
  76.   End Select
  77.  
  78.   HookMessages = CallWindowProc(lOldWndProc, lhWnd, msg, wParam, lParam)
  79. End Function
  80.  
  81. Public Sub Hook(lhWnd As Long)
  82.   If bIsHooked = True Then Exit Sub
  83.   bIsHooked = True
  84.   lHook = lhWnd
  85.   lOldWndProc = SetWindowLong(lHook, GWL_WNDPROC, AddressOf HookMessages)
  86. End Sub
  87.  
  88. Public Sub UnHook()
  89.   If bIsHooked = False Then Exit Sub
  90.   bIsHooked = False
  91.   Call SetWindowLong(lHook, GWL_WNDPROC, lOldWndProc)
  92. End Sub
  93.